home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #55 (1991-04-07)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #55 (1991-04-07)(Amiga User Gruppe Einzugsgebiet 4000).adf / hardcopy / HardCopy.mod < prev    next >
Text File  |  1991-04-08  |  6KB  |  184 lines
  1. (*****************************************************************************
  2.  * Programm : Hardcopy                                                       *
  3.  * Version  : V 1.00                                                         *
  4.  * Datum    : 06.04.1991                                                     *
  5.  * Idee     : Kickstart 04/91                                                *
  6.  * Modula-Umsetzung : G. Heeke                                               *
  7.  * Compiler : Benchmark Modula-2                                             *
  8.  * Funktion : Sobald Alt-* auf dem Nummernfeld betätigt wird, wird vom       *
  9.  *            aktuellen Schirm eine Hardcopy angefertigt. Das Programm wird  *
  10.  *            entfernt, wenn ein Ausdruck vom Benutzer abgebrochen wird.     *
  11.  *****************************************************************************)
  12. MODULE Hardcopy;
  13. FROM IODevices IMPORT OpenDevice, CloseDevice, DoIO,IOStdReqPtr;
  14. FROM IODevicesUtil IMPORT CreateStdIO,DeleteStdIO,CreateExtIO,DeleteExtIO;
  15. FROM InputDevice IMPORT INDAddHandler,INDRemHandler;
  16. FROM InputEvents IMPORT InputEventPtr,IEQualifier,IEQualifierSet,IEClass;
  17. FROM Ports IMPORT MsgPortPtr;
  18. FROM PortsUtil IMPORT CreatePort,DeletePort;
  19. FROM Interrupts IMPORT Forbid,Permit,Interrupt;
  20. FROM Tasks IMPORT AllocSignal,FreeSignal,SetSignal,Signal,SignalSet,SignalRange,
  21.                   NoSignals,TaskPtr,FindTask,Wait;
  22. FROM PrinterDevice IMPORT IODRPReq,IODRPReqPtr,RPDDumpRPort,Special,SpecialSet;
  23. FROM Intuition IMPORT ScreenPtr,DisplayBeep;
  24. FROM IntuitionBase IMPORT IntuitionBasePtr;
  25. FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,INLINE,REG,SETREG,TSIZE;
  26. FROM System IMPORT argc,StdOutput,StdInput,IntuitionBase;
  27. FROM AmigaDOS IMPORT Open,ModeNewFile,Close;
  28.  
  29. VAR inputhandler : Interrupt;
  30.     inputport    : MsgPortPtr;
  31.     inputreqblk  : IOStdReqPtr;
  32.     signalnumber : SignalRange;
  33.     signal       : SignalSet;
  34.     mytask       : TaskPtr;
  35.     Fehler       : LONGINT;
  36.     PPort        : MsgPortPtr;
  37.     PrintIO      : IODRPReqPtr;
  38.     Aktiv        : ScreenPtr;
  39.     Intui        : IntuitionBasePtr;
  40.     
  41. PROCEDURE RemHandler; FORWARD;
  42.  
  43. PROCEDURE CloseDownPrinter;
  44. BEGIN
  45.   IF PrintIO^.ioDevice # NIL THEN CloseDevice(PrintIO) END;
  46.   IF PrintIO # NIL THEN DeleteExtIO(PrintIO);PrintIO := NIL END;
  47.   IF PPort # NIL THEN DeletePort(PPort^);PPort := NIL END;
  48. END CloseDownPrinter;
  49.   
  50. PROCEDURE CloseDown;
  51. BEGIN
  52.   CloseDownPrinter;
  53.   RemHandler;
  54.   HALT;
  55. END CloseDown;
  56.     
  57. PROCEDURE InputHandler():InputEventPtr;
  58. VAR event: InputEventPtr;
  59.  
  60. BEGIN
  61.   event := ADDRESS(REG(8));
  62.   Forbid;
  63.   WITH event^ DO
  64.     IF (ieClass = IEClassRawKey) AND (ieCode = 5DH) AND
  65.        ((IEQualifierSet{IEQualifierLAlt,IEQualifierRAlt} * ieQualifier) #
  66.         IEQualifierSet{})
  67.     THEN
  68.       Signal(mytask^,signal);
  69.     END;(*IF*)
  70.   END;(*WITH*)
  71.   Permit;
  72.   RETURN event;
  73. END InputHandler;
  74.             
  75. PROCEDURE Interface;
  76. BEGIN
  77.   INLINE(048E7H,03F3EH);
  78.   SETREG(0,InputHandler());
  79.   INLINE(04CDFH,07CFCH);
  80.   INLINE(04E75H);
  81. END Interface;
  82.  
  83. PROCEDURE AddHandler;
  84. BEGIN
  85.   inputport := CreatePort(ADR("HardcopyPort"),0);
  86.   inputreqblk := CreateStdIO(inputport^);
  87.   Fehler := OpenDevice(ADR("input.device"),0,inputreqblk,0D);
  88.   IF Fehler # 0D THEN CloseDown END;
  89.   WITH inputhandler DO
  90.     isCode := ADR(Interface)+10D;
  91.     isNode.lnPri := BYTE(51);
  92.     isNode.lnName := ADR("Hardcopy.handler");
  93.   END;(*WITH*)
  94.   inputreqblk^.ioCommand := INDAddHandler;
  95.   inputreqblk^.ioData := ADR(inputhandler);
  96.   Fehler := DoIO(inputreqblk);
  97.   IF Fehler # 0D THEN CloseDown END;
  98.   signalnumber := AllocSignal(-1);
  99.   IF signalnumber = NoSignals THEN CloseDown END;
  100.   signal := SignalSet{ORD(signalnumber)};
  101. END AddHandler;
  102.  
  103. PROCEDURE RemHandler;
  104. BEGIN
  105.   IF inputreqblk # NIL THEN
  106.     WITH inputreqblk^ DO
  107.       IF ioDevice # NIL THEN
  108.         ioCommand := INDRemHandler;
  109.         ioData := ADR(inputhandler);
  110.         Fehler := DoIO (inputreqblk);
  111.         CloseDevice(inputreqblk);
  112.       END;(*IF*)
  113.     END;(*WITH*)
  114.     DeleteStdIO(inputreqblk);
  115.     inputreqblk := NIL;
  116.   END;(*IF*)
  117.   
  118.   IF inputport # NIL THEN
  119.     DeletePort(inputport^);
  120.     inputport := NIL;
  121.   END;(*IF*)               
  122.  
  123.   IF signal # SignalSet{} THEN
  124.     FreeSignal(signalnumber);
  125.     signal := SignalSet{};
  126.   END;(*IF*)
  127.   
  128.  END RemHandler;
  129.  
  130. PROCEDURE WaitforHardcopy;
  131.  VAR sig : SignalSet;
  132.  
  133.  BEGIN
  134.    AddHandler;
  135.    sig := Wait(signal);
  136.    RemHandler;
  137. END WaitforHardcopy;
  138.  
  139. PROCEDURE MakeHardcopy() :BOOLEAN;
  140.   
  141. BEGIN
  142.   Aktiv := Intui^.ActiveScreen;
  143.   PPort := CreatePort(NIL,0);
  144.   IF PPort = NIL THEN CloseDown END;
  145.   PrintIO := CreateExtIO(PPort^,TSIZE(IODRPReq));
  146.   IF PrintIO = NIL THEN CloseDown END;
  147.   Fehler := OpenDevice(ADR("printer.device"),0,PrintIO,0D);
  148.   IF Fehler # 0D THEN CloseDown END;
  149.   
  150.   WITH PrintIO^ DO
  151.     ioCommand  := RPDDumpRPort;
  152.     ioRastPort := ADR(Aktiv^.RastPort);
  153.     ioColorMap := Aktiv^.ViewPort.ColorMap;
  154.     ioModes    := LONGCARD(Aktiv^.ViewPort.Modes);
  155.     ioSrcX     := 0;
  156.     ioSrcY     := 0;
  157.     ioSrcWidth := Aktiv^.Width;
  158.     ioSrcHeight:= Aktiv^.Height;
  159.     ioDestCols := 0;
  160.     ioDestRows := 0;
  161.     ioSpecial  := SpecialSet{SpecialFullCols,SpecialAspect};
  162.   END;(*WITH*)
  163.   
  164.   Fehler := DoIO(PrintIO);
  165.   IF Fehler # 0D THEN DisplayBeep(NIL);RETURN FALSE; END;
  166.   CloseDownPrinter;
  167.   RETURN TRUE;
  168. END MakeHardcopy;
  169.        
  170. BEGIN (*HAUPTPROGRAMM*)
  171.   Intui := IntuitionBase;
  172.   mytask := FindTask(NIL);
  173.   IF argc = 0  THEN (* Von der Workbench gestartet, Fenster schließen *)
  174.     Close(StdOutput);
  175.     StdOutput := Open(ADR("NIL:"),ModeNewFile);
  176.     StdInput := StdOutput;
  177.   END;  
  178.   REPEAT  
  179.     WaitforHardcopy;
  180.   UNTIL NOT MakeHardcopy();
  181.   CloseDown;
  182. END Hardcopy.       
  183.  
  184.